perm filename XAP[XGP,BGB]1 blob sn#023243 filedate 1973-02-04 generic text, type T, neo UTF8
00100	TITLE XAP - XEROX ASSEMBLE AND PRINT - BGB - 27 JANUARY 1973.
00200	
00300	
00400	COMMENT/
00500		PHYSICAL PAGE SIZE  8.5" BY 11"
00600		PRINTIBLE PAGE SIZE 7.5" BY 10"
00700		7.5" IS 40 WORDS PER LINE IS 1440 XCOLUMNS.
00800		10" IS 2000 XROWS.
00900		BUFFER SIZE IS (41 WORDS PER ROW)*(2000 ROWS) = 82000 WORDS.
01000	
01100	FONT FILE AND UPPER SEGMENT FORMAT.
01200		
01300		00 ↔ GLYPH1 ↔ BLOCK 176	; =128 WORD GLYPH POINTER TABLE.
01400	
01500	GLYPH1:	XWD ROWS,WORDS	;ROWS IN THE GLYPH, WORD WIDTH OF GLYPH.
01600		XWD R0,C0	;GLYPH ORIGIN RELATIVE TO PEN POSITION.
01700		XWD R1,C1	;GLYPH TERMINUS RELATIVE TO PEN POSITION.
01800		BLOCK ROWS*WORDS
01900	/
02000	
02100		DECLARE{ORGBUF,ENDBUF,ROW,COL,DROW,DCOL}
02200		O(ATTSEG,CALLI 400016)
02300		O(DETSEG,CALLI 400017)
02400		O(SEGNUM,CALLI 400021)
02500		O(CORE2, CALLI 400015)
02600		$←←400000
02700	
     

00100	SUBR(MKBUF)-------------------------------------------------------
00200	BEGIN MKBUF;MAKE XGP BUFFER - BGB - 27 JANUARY 1973.
00300	
00400	;EXPAND CORE FOR XGP BUFFER.
00500		LAC 44↔DAC ORGBUF
00600		ADDI =82000↔DAC ENDBUF↔AOS ORGBUF
00700		ADDI 10↔IORI 1777
00800		CALLI 11↔HALT
00900	
01000	;CLEAR XGP BUFFER.
01100		LAC 1,ORGBUF↔SETZM(1)
01200		DIP 1,1↔AOS 1
01300		CDR 2,ENDBUF↔BLT 1,(2)
01400		POP0J
01500	
01600	BEND;1/27/73------------------------------------------------------
01700	
01800	
     

00100	SUBR(XGPOUT)------------------------------------------------------
00200	BEGIN XGPOUT
00300	
00400	;PUT CONTROL WORD IN EACH ROW.
00500		LAC[1B11+=100B23+=40]
00600		LAC 1,ORGBUF
00700		LACI 2,=2000		;NUMBER OF ROWS.
00800		DAC(1)↔ADDI 1,=41	;ROW WORD WIDTH.
00900		SOJG 2,.-2
01000	
01100	;CALL THE IOTS.
01200		LAC ORGBUF↔SOS↔DAP OUT2
01300		INIT 2,17↔SIXBIT/XGP/↔0↔HALT
01400		OUT 2,OUT1
01500		RELEASE 2,
01600		OUTSTR[ASCIZ/
01700	*/]
01800	
01900	;CLEAR XGP BUFFER.
02000		LAC 1,ORGBUF↔SETZM(1)
02100		DIP 1,1↔AOS 1
02200		CDR 2,ENDBUF↔BLT 1,(2)
02300		POP0J
02400	
02500	;-----------------------------------------------------------------
02600	OUT1:	IOWD 2,HACK1
02700	OUT2:	IOWD =82000,0
02800	OUT3:	IOWD 2,HACK2
02900		0
03000	
03100	HACK1:	1B0
03200		1B0 + =80B11
03300	HACK2:	1B0 + =80B11
03400		0↔0
03500	BEND;1/31/73------------------------------------------------------
     

00100	SUBR(GETFIL)------------------------------------------------------
00200	BEGIN GETFIL;GET FILE SPEC FROM TTY LINE - BGB - 10 DEC 72.
00300	
00400		SETZM FILNAM↔SETZM EXTION
00500		SETZM EXTION+1↔SETZM PPPN
00600	;	CRLF
00700		OUTSTR[ASCIZ/ FILE = /]
00800		LAC 1,[POINT 6,FILNAM,-1]↔LACI 2,6
00900		INCHWL↔CAIN 15↔GO[INCHWL↔POP0J]↔AOSA(P)
01000	L:	INCHWL
01100		CAIN"."↔GO[LAC 1,[POINT 6,EXTION,-1]↔LACI 2,3↔GO L]
01200		CAIN"["↔GO[LAC 1,[POINT 6,PPPN,-1]  ↔LACI 2,3↔GO L]
01300		CAIN","↔GO[LAC 1,[POINT 6,PPPN,17]  ↔LACI 2,3↔GO L]
01400		CAIN"]"↔GO L
01500		CAIN 15↔GO EOL			;END OF THE LINE.
01600		CAIN 12↔GO EOL
01700		CAIG" "↔GO L	;IGNORE GARBAGE.
01800		SOJL 2,L↔SUBI 40↔IDPB 1↔GO L
01900	
02000	EOL:	INCHWL
02100		POP0J
02200	BEND;1/31/73-------------------------------------------------------
02300	
02400	FILNAM:	0	;FILE NAME.
02500	EXTION:	0	;EXTENSION.
02600		0
02700	PPPN:	0	;PROJECT-PROGRAMMER.
02800	FNTPPN:	SIXBIT/XGPTVR/		;DEFAULT FONT PPN
02900	IBUF:	0↔0↔0↔0
03000	
03100	SUBR(GETCHR)------------------------------------------------------
03200	BEGIN GETCHR;GET CHARACTER AND SKIP.
03300		SOSG IBUF+2
03400		IN 3,0
03500		GO[ILDB 1,IBUF+1↔AOS(P)↔POP0J]
03600		STATO 3,1B22
03700		HALT
03800		RELEASE 3,	;EOF.
03900		POP0J
04000	BEND;1/31/73------------------------------------------------------
     

00100	SUBR(PLAG)GLYPH---------------------------------------------------
00200	BEGIN PLAG;PLACE A GLYPH INTO THE XGP BUFFER AT ROW,COL.
00300	;BGB - 27 JANUARY 1973.
00400	
00500		ACCUMULATORS{G,B,B2,M,N,I}
00600		LAC G,ARG1
00700	
00800	;ORIGIN AND BUFFER POINTER.
00900	
01000		NIP 1(G)↔ADD ROW↔DAC ROW
01100		IMULI =41↔ADD ORGBUF↔DAPZ B
01200	
01300		NAP 1(G)↔ADD COL↔DAC COL
01400		IDIVI =36↔AOS
01500		ADD B,0↔MOVNS 1↔DAP 1,L3
01600	
01700		CAR M,0(G)↔CDR N,0(G)
01800		DIP G,G↔ADDI G,3
01900		DAC B,B2
02000	
02100	;INCLUSIVE OR GLYPH BITS INTO THE XGP BUFFER.
02200	
02300	L1:	LAC I,N
02400	L2:	LAC 0,(G)↔SETZ 1,
02500	L3:	LSHC 0,0
02600		CAML B,ORGBUF↔CAMLE B,ENDBUF↔SKIPA↔IORM 0,(B)
02700		AOS B
02800		CAML B,ORGBUF↔CAMLE B,ENDBUF↔SKIPA↔IORM 1,(B)
02900		AOS G
03000		SOJG I,L2↔LAC B,B2
03100		ADDI B,=41↔DAC B,B2
03200		SOJG M,L1↔LIP G,G
03300	
03400	;TERMINUS.
03500	
03600		NIP 2(G)↔ADD ROW↔DAC ROW
03700		NAP 2(G)↔ADD COL↔DAC COL
03800		POP1J
03900	BEND;1/27/73------------------------------------------------------
     

00100	;START ADDRESS ENTRY.
00200		PDL:BLOCK 100;CONTROL PUSH DOWN.
00300		PAT:BLOCK 100;PATCH AREA.
00400	SA:	JFCL
00450		CALLI 0
00500		LAC 17,[IOWD 100,PDL]
00600	
00700	;RE-ENTRY ADDRESS.
00800	REE:	LACI .↔DAC 124
00900	
01000	;AD HOC TEMP CODE  -  GET FONT FILE 0 INTO UPPER SEGMENT.
01100	
01200		INIT 1,17↔SIXBIT/DSK/↔0↔HALT
01300	;	LOOKUP 1,[SIXBIT/0/↔0↔0↔FILSIZ:0]↔HALT
01400		filsiz←filnam+3
01500		outstr [asciz/FONT/]
01600		CALL(GETFIL)↔JFCL
01700		LOOKUP 1,FILNAM
01800		GO [	HRLI 'XAP'↔SKIPN EXTION↔HLLZM EXTION
01900			LOOKUP 1,FILNAM
02000			GO [	MOVE FNTPPN↔SKIPN PPPN↔MOVEM PPPN
02100				LOOKUP 1,FILNAM
02150				GO [	OUTSTR[ASCIZ/NOT FOUND, TRY AGAIN
02200	/]
02300					GO .-4]
02350				GO .+1]
02400			GO .+1]
02500		LAC FILSIZ↔LAPI $↔SOS↔DAC INARG		;IOWD.
02600		MOVS FILSIZ↔MOVMS↔ADDI $↔CORE2↔HALT	;MAKE UPPER SEG.
02700		LAC[SIXBIT/FONT00/]↔CALLI $+36↔JFCL	;NAME UPPER SEG.
02800		IN 1,[INARG:0↔0]
02900		RELEASE 1,
03000	
03100	;INITIALIZE XGP BUFFER.
03200	restar:	CALL(MKBUF)
03300	
03400	;SOS TEXT FILE - OUTPUT LPT STYLE.
03500	L0:	INIT 3,0↔SIXBIT/DSK/↔IBUF↔HALT
03600		outstr [asciz/TEXT/]
03700		CALL(GETFIL)↔CALLI 12
03800		LOOKUP 3,FILNAM
03900		GO .-4
04000		INBUF 3,
     

00100		LACI =100↔DAC ROW
00200		SETZM COL
00300	
00400		LACI =40↔DAC DROW		;LINE FEED DEFAULT.
00500		LAC 2,$+12↔JUMPN 2,[		;LINE FEED SPECIFIED.
00600			NIP 0,$+1(2)↔NIP 1,$+2(2)
00700			ADD 0,1↔DAC 0,DROW↔GO .+1]
00800	
00900		LACI =25↔DAC DCOL		;SPACE DEFAULT.
01000		LAC 2,$+40↔JUMPN 2,[		;SPACE SPECIFIED.
01100			NAP 0,$+1(2)↔NAP 1,$+2(2)
01200			ADD 0,1↔DAC 0,DCOL↔GO .+1]
01300	
01400	
     

00100	L2:	CALL(GETCHR)
00200		GO[CALL(XGPOUT)↔CALLI 12]			;EOF.
00300		JUMPE 1,L2					;NULL.
00400		CAIN 1,11↔GO[LAC COL↔IDIV DCOL↔ANDCMI 7		;TAB.
00500			ADDI 8↔IMUL DCOL↔DAC COL↔GO L2]
00600		CAIN 1,15↔GO[SETZM COL↔GO L2]			;RETURN.
00700		CAIN 1,14↔GO[CALL(XGPOUT)↔LACI =100↔DAC ROW	;FF.
00800			SETZM COL↔GO L2]
00900	 	CAIN 1,40↔GO[LAC DCOL↔ADDM COL↔GO L3]		;SPACE.
01000	 	CAIN 1,12↔GO[LAC DROW↔ADDB ROW↔CAIGE =2000	;LINE FEED.
01100		GO L2↔CALL(XGPOUT)↔LACI =100↔DAC ROW↔GO L2]	;ROW OVERFLOW.
01200	
01300	;FONT TABLE LOOKUP AND PLACE CHARACTER'S GLYPH INTO XGP BUFFER.
01400		LAC 0,$(1)
01500		JUMPE L2↔ADDI $
01600		CALL(PLAG,0)
01700	
01800	;COLUMN OVERFLOW - DEFAULT CRLF.
01900	L3:	LAC COL↔CAILE =1440↔GO[
02000		SETZM COL↔LAC DROW↔ADDM ROW↔GO L2]
02100		GO L2
02200	
02300	END SA